{******************************************************************************}
{ @UnitName    : uMsgEventImpl                                                 }
{ @Project     : MsgClient                                                     }
{ @Copyright   : Je01                                                          }
{ @Author      : SH-JULIAN                                                     }
{ @CreateDate  : 2003-07-19 15:13:07                                           }
{ @LastUpdate  : 2003-08-29 10:42:30 by SH-JULIAN                              }
{ @Description :                                                               }
{ @Comment     :                                                               }
{ @History     :                                                               }
{******************************************************************************}
unit uMsgEventImpl;

interface

uses
  uPacket,
  uMsgClient,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,MessageClient_TLB,ActiveX, ComObj, StdCtrls;

type
  TMsgEventSink = class(TInterfacedObject, IUnknown,IDispatch)
  private
    {IUknown methods}
    fMsg:TMsgClient;
    function QueryInterface(const IID: TGUID; out Obj):HResult;stdcall;
    {Idispatch}
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  public
    Constructor Create(aOwner:TMsgClient);
  end;


implementation

{ TMsgEventSink }

Constructor TMsgEventSink.Create(aOwner:TMsgClient);
begin
  fMsg:=aOwner;

end;

function TMsgEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := S_OK
end;

function TMsgEventSink.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Result := S_OK
end;

function TMsgEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Result := S_OK
end;

function TMsgEventSink.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
var
  Args: PVariantArgList;
  iCode:Integer;
  sMsg:string;
  sError:String;
  lsHead,lsBody:TStringList;
begin
  lsHead:=TStringList.Create;
  lsBody:=TStringList.Create;
  try
    Result := S_OK;
    Args := TDispParams(Params).rgvarg;
    sMsg:= OleVariant(Args^[0]);
    //parse the message
    if ParsePacket(sMsg,lsHead, lsBody,sError) then
    begin
      case DispID of
        1: fMsg.DoBizMsg(sMsg);
      end;
    end;
  finally
    lsHead.Free;
    lsBody.Free;
  end;
end;

function TMsgEventSink.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterFace(IID,Obj) then
    Result := S_OK
  else if IsEqualIID(IID,IMsgClientEvents) then
    Result := QueryInterface(IDispatch,Obj)
  else
    Result := E_NOINTERFACE;
end;

end.
